solve_24 Subroutine

public recursive subroutine solve_24(nums, exprs, found)

Recursively solves the 24 game by trying all possible operations. Utilizes OpenMP tasks for parallelization.

Arguments

Type IntentOptional Attributes Name
real, intent(in) :: nums(:)

Input: Array of numbers.

character(len=expr_len), intent(in) :: exprs(:)

Input: Array of string expressions representing the numbers.

logical, intent(inout) :: found

Input/Output: Flag indicating if a solution is found.


Calls

proc~~solve_24~~CallsGraph proc~solve_24 solve_24 proc~solve_24->proc~solve_24 omp_get_level omp_get_level proc~solve_24->omp_get_level proc~create_new_arrays create_new_arrays proc~solve_24->proc~create_new_arrays proc~update_progress_bar update_progress_bar proc~solve_24->proc~update_progress_bar

Called by

proc~~solve_24~~CalledByGraph proc~solve_24 solve_24 proc~solve_24->proc~solve_24 program~game24_ultra game24_ultra program~game24_ultra->proc~solve_24

Source Code

    recursive subroutine solve_24(nums, exprs, found)
    !! Recursively solves the 24 game by trying all possible operations.
    !! Utilizes OpenMP tasks for parallelization.
        real, intent(in)                         :: nums(:)
    !! Input: Array of numbers.
        character(len=expr_len), intent(in)      :: exprs(:)
    !! Input: Array of string expressions representing the numbers.
        logical, intent(inout)                   :: found
    !! Input/Output: Flag indicating if a solution is found.
        integer                                  :: n
    !! Size of the input arrays.
        integer                                  :: i, j, op
    !! Loop counters for numbers and operators.
        real                                     :: a, b, result
    !! Temporary variables for calculations.
        real, allocatable                        :: new_nums(:)
    !! Temporary array to store numbers after an operation.
        character(len=expr_len), allocatable     :: new_exprs(:)
    !! Temporary array to store expressions after an operation.
        character(len=expr_len)                  :: expr_a, expr_b, new_expr
    !! Temporary variables for expressions.

        n = size(nums)

        ! Increment the completed_calls counter and update progress bar
        if (show_progress) then
            !$omp atomic
            completed_calls = completed_calls + 1
            call update_progress_bar()
        end if

        ! If a solution is found, return
        if (found) return

        ! Base case: If only one number is left, check if it is 24
        if (n == 1) then
            if (abs(nums(1) - 24.0) < 1e-4) then
                if (show_progress) then
                    write (*, '(A, F5.1, A)', advance='no') carriage_return//'['//repeat('=', progress_bar_width)//'] ', 100.0, '%'
                    write (*, '(A)') ''  ! Insert a blank line
                end if
                !$omp critical
                write (*, '(A, A, A, F10.7, A)') 'Solution found:', trim(exprs(1)), '= 24 (', nums(1), ')'
                found = .true.
                !$omp end critical
            end if
            return
        end if

        ! Iterate over all pairs of numbers
        do i = 1, n - 1
            do j = i + 1, n
                a = nums(i)
                b = nums(j)
                expr_a = exprs(i)
                expr_b = exprs(j)

                ! Iterate over all operators
                do op = 1, 4
                    ! Avoid division by zero
                    if ((op == 4 .and. abs(b) < 1e-6)) cycle

                    ! Perform the operation and create the new expression
                    select case (op)
                    case (1)
                        result = a + b
                        new_expr = '('//trim(expr_a)//'+'//trim(expr_b)//')'
                    case (2)
                        result = a - b
                        new_expr = '('//trim(expr_a)//'-'//trim(expr_b)//')'
                    case (3)
                        result = a * b
                        new_expr = '('//trim(expr_a)//'*'//trim(expr_b)//')'
                    case (4)
                        result = a / b
                        new_expr = '('//trim(expr_a)//'/'//trim(expr_b)//')'
                    end select

                    ! Create new arrays with the selected numbers removed
                    call create_new_arrays(nums, exprs, i, j, result, new_expr, new_nums, new_exprs)

                    ! For the first few recursion levels, create parallel tasks
                    if (n >= 6 .and. omp_get_level() < 2) then
                        !$omp task shared(found) firstprivate(new_nums, new_exprs)
                        call solve_24(new_nums, new_exprs, found)
                        !$omp end task
                    else
                        call solve_24(new_nums, new_exprs, found)
                    end if

                    ! If a solution is found, deallocate memory and return
                    if (found) then
                        deallocate (new_nums)
                        deallocate (new_exprs)
                        return
                    end if

                    ! Handle commutative operations only once
                    if (op == 1 .or. op == 3) cycle

                    ! Swap operands for subtraction and division
                    if (op == 2 .or. op == 4) then
                        if (op == 4 .and. abs(a) < 1e-6) cycle  ! Avoid division by zero

                        select case (op)
                        case (2)
                            result = b - a
                            new_expr = '('//trim(expr_b)//'-'//trim(expr_a)//')'
                        case (4)
                            result = b / a
                            new_expr = '('//trim(expr_b)//'/'//trim(expr_a)//')'
                        end select

                        ! Create new arrays with the selected numbers removed
                        call create_new_arrays(nums, exprs, i, j, result, new_expr, new_nums, new_exprs)

                        ! For the first few recursion levels, create parallel tasks
                        if (n >= 6 .and. omp_get_level() < 2) then
                            !$omp task shared(found) firstprivate(new_nums, new_exprs)
                            call solve_24(new_nums, new_exprs, found)
                            !$omp end task
                        else
                            ! Recursively call the solve_24 function with the new arrays
                            call solve_24(new_nums, new_exprs, found)
                        end if

                        ! If a solution is found, deallocate memory and return
                        if (found) then
                            deallocate (new_nums)
                            deallocate (new_exprs)
                            return
                        end if
                    end if

                end do  ! End of operator loop
            end do  ! End of j loop
        end do  ! End of i loop
    end subroutine solve_24